
module Main where
import System.Environment
import Text.ParserCombinators.Parsec hiding (spaces)
import Monad
import Numeric
import Char

data LispVal = Atom String
             | List [LispVal]
             | DottedList [LispVal] LispVal
             | Number Integer
             | Float Float
             | String String
             | Bool Bool
             | Character String

symbol = oneOf "!$#%&|*+-/:<=>?@^_~"

{- Original parseString -}
{- parseString = do 
    char '"'
    x <- many (noneOf "\"")
    char '"'
    return $ String x -}

parseCharacter = do
    string "\\#"
    x <- many (letter <|> digit <|> symbol)
    return $ Character $ case x of
        "space" -> " "
        "tab" -> "\t"
        "newline" -> "\n"
        _ -> x
    
parseEsc = do
    char '\\'
    esc <- letter
    return $ case esc of 
        '"' -> "\""
        'n' -> "\n"
        'r' -> "\r"
        'f' -> "\f"
        't' -> "\t"
        _ -> foldr (:) "" ['\\', esc]

{- parseString with support for escaped dquote -}
parseString = do 
    char '"'
    x <- (many (noneOf "\"") <|> parseEsc)
    char '"'
    return $ String x

parseAtom :: Parser LispVal
parseAtom = do 
    first <- letter <|> symbol
    rest <- many (letter <|> digit <|> symbol)
    let atom = [first] ++ rest
    return $ case atom of 
        "#t" -> Bool True
        "#f" -> Bool False
        otherwise -> Atom atom

{- 3.3.1 -}
{- Original parseNumber -}
{- parseNumber = liftM (Number . read) $ many1 digit -}

{- parseNumber with do Notation -}
{- parseNumber = do
    num <- many1 digit
    return $ Number $ read num -}

{- parseNumber using the >>= operator -}
parseNumWith r = many1 digit >>= return . Number . r

isBinDigit d = case d of
    '0' -> True
    '1' -> True
    _ -> False

parseDecimal = parseNumWith read
parseHex = string "#x" >> parseNumWith (fst . head . readHex)
parseOct = string "#x" >> parseNumWith (fst . head . readOct)
parseBin = do
    string "#b" 
    parseNumWith (fst . head . (readInt 2 isBinDigit digitToInt))
parseFloat = do
    string "#e" <|> string "#i" <?> ""
    fltfields <- do
        many1 digit
        char '.'
        many1 digit
    return $ Float $ (fst.head.readFloat) $ foldr (:) "" fltfields
    
parseNumber = parseFloat
    <|> parseDecimal 
    <|> parseHex 
    <|> parseOct
    <|> parseBin

spaces = skipMany1 space

parseExpr :: Parser LispVal
parseExpr = parseAtom
        <|> parseString
        <|> parseNumber
        <|> parseCharacter

readExpr :: String -> String
readExpr input = 
    case parse parseExpr "lisp" input of
        Left err -> "No match: " ++ show err
        Right val -> "Found value: "

main = do 
    args <- getArgs
    putStrLn (readExpr (args !! 0))
    